home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / embedded / mcu / float09.arc / PROCS.SA < prev    next >
Text File  |  1987-03-04  |  8KB  |  301 lines

  1. *
  2.  NAM  PROCS
  3. *
  4. * LINKING LOADER DEFINITIONS
  5. *
  6.   XDEF    TFRACT,LNORM,SNORM,PREC,SIZE,SIZTAB,ENORM
  7. *
  8. * REVISION HISTORY:
  9. *
  10. *   DATE    PROGRAMMER     REASON
  11. *
  12. *  28.MAY.80    G. STEVENS     ORIGINAL
  13. *  06.JUN.80    G. STEVENS     FIX TFRACT
  14. *  10.JUL.80    J. BONEY       CHANGE TFRACT,SNORM
  15. *  15.JUL.80    J. BONEY       MAKE ENORM,SNORM & LNORM
  16. *                   USE MUTUAL CODE.
  17. *  19.AUG.80    G. STEVENS     LNORM SETS TYPE PROPERLY
  18. *  20.AUG.80    J. BONEY       SPEED UP TFRACT
  19. *  08.0CT.80    G. STEVENS     CORRECT STACK OFFSET IN ENORM
  20. *  09.OCT.80    G. STEVENS     CORRECT ADDR. MODE IN TFRACT
  21. *
  22.   PAGE
  23. *
  24. ******************************************************
  25. *
  26. *    G L O B A L  P R O C E D U R E S
  27. *
  28. ********************************************************
  29. *
  30. *
  31. *   THESE PROCEDURES ARE USED BY ALL MODULES AND
  32. *   HENCE ARE GLOBAL.
  33. *
  34. *   IF THESE PROCEDURES NEED SUB-PROCEDURES, THEY ARE
  35. *   INCLUDED HERE. IF THE SUB-PROCEDURES ARE
  36. *   GENERAL PURPOSE, THEY ARE CONSIDERED PROCEDURES
  37. *   IN THEIR OWN RIGHT
  38. *
  39. *   IF PROCEDURES ARE ONLY USED LOCALLY BY A MODULE
  40. *   THEY ARE NOT INCLUDED HERE.  THEY ARE
  41. *   IN THE MODULE THAT USES THEM
  42. *
  43. *
  44. *
  45. ******************************************************
  46. *
  47. *
  48. *************
  49. *
  50. * TFRACT - TEST FRACTION FOR ZERO
  51. *    AND SETS THE Z BIT IF THE RESULT IS ZERO
  52. *
  53. * ENTRY:
  54. *    X = POINTER TO ARGUMENT ON STACK FRAME
  55. *
  56. * EXIT:
  57. *    D = DESTROYED
  58. *    Z = 1 IF ALL FRACTION BITS ARE ZERO
  59. *
  60. ***************
  61. *
  62. TFRACT EQU *
  63.   LDD  FRACT,X       TEST FOR ZERO 2 BYTES AT A TIME
  64.   BNE  TFOUT
  65.   LDD  FRACT+2,X
  66.   BNE  TFOUT       EXIT AS SOON AS A NON ZERO WORD OCCURS
  67.   LDD  FRACT+4,X
  68.   BNE  TFOUT
  69.   LDD  FRACT+6,X
  70.   BNE  TFOUT
  71.   LDA  FRACT+8,X   CHECK LAST BYTE
  72. TFOUT EQU *
  73.   RTS           EXIT WITH Z
  74. *
  75.   PAGE
  76. *
  77. ******************************************************
  78. *
  79. *   LNORM,SNORM - NORMALIZE A NUMBER
  80. *        THAT IS IN INTERNAL FORM
  81. *
  82. *   ON ENTRY: X POINTS TO THE ARGUMENT ON THE STACK FRAME
  83. *
  84. *   ON EXIT:  THE NUMBER POINTED TO BY X IS NORMALIZED
  85. *          Z IS SET IF FRACTION WAS ZERO. ALSO THE
  86. *        NUMBER IS SET TO TRUE ZERO
  87. *          V IS SET IF NUMBER BECAME DENORMALIZED
  88. *        DURING NORMALIZATION.
  89. *          Z AND V ARE CLEARED OTHERWISE
  90. *
  91. *   NOTE: MUCH OF THE CODE IS SHARED WITH THE 'ENORM'
  92. *   PROCEDURE. IT IS IDENTICAL TO SNORM/LNORM EXCEPT
  93. *   FOR ITS LOOP TERMINATION CONDITIONS. THEREFORE
  94. *   SNORM/LNORM PUSH A FLAG ON THE STACK THAT IS USED
  95. *   BY THE MUTUAL CODE TO DETERMINE WHICH LOOP TERMINATOR
  96. *   TO USE.
  97. ********************************************************
  98. *
  99. SNORM EQU *             DOUBLE ENTRY FOR THIS ROUTINE
  100. LNORM EQU *
  101.   PSHS    D,Y        SAVE CALLER'S REGS
  102.   CLR  TYPE,X             SET TYPE TO NORMALIZED
  103.   CLR  ,-S             FLAG = 0 = SNORM,LNORM CALL
  104. *
  105. MUTNRM EQU *             ENORM ENTRY PT.
  106. *
  107.   BSR  TFRACT             IF FRACTION = 0 THEN
  108.   IFCC    EQ
  109.     MOVD  #$8000,(EXP,X)     SET TO ZERO
  110.     MOVA #TYZERO,(TYPE,X)    CHANGE TYPE TO ZERO
  111.     ORCC  #Z             SET Z BIT (V=0)
  112.     BRA SNOUT             EXIT
  113.   ENDIF
  114.   LDY  EXP,X             PUT EXPONENT IN REG FOR SPEED
  115.   LDA  FRACT,X             PUT MSB OF FRACTION IN REG FOR SPEED
  116.   IFTST  (,S),EQ,#0         SNORM/LNORM CALL
  117.     TSTA             EXIT IF ALREADY
  118.     BMI  SNOUT             NORMALIZED.
  119. *
  120.   ELSE                 ENORM CALL
  121.     IF    Y,LE,(3,S)         EXIT IF ALREADY
  122.       BRA  SNOUT         AT ORIGINAL EXPONENT
  123. *
  124.     ENDIF
  125. *
  126.   ENDIF
  127. *
  128. SNLOOP    EQU  *
  129.     DECY  .             DEC EXPONENT
  130.     IF    Y,EQ,#$8000         IF DOWN TO MIN EXPONENT THEN
  131.       STA  FRACT,X         RESTORE FRACCTION AND EXPONENT
  132.       STY  EXP,X
  133.       MOVA #TYNNRM,(TYPE,X)  CHANGE TYPE TO NOT NORMALIZED
  134.       ORCC  #V             SET V BIT (Z=0)
  135.       BRA  SNOUT         EXIT
  136.     ENDIF
  137.     LSL  FRACT+8,X         SHIFT FRACTION 1 BIT LEFT
  138.     ROL  FRACT+7,X
  139.     ROL  FRACT+6,X
  140.     ROL  FRACT+5,X
  141.     ROL  FRACT+4,X
  142.     ROL  FRACT+3,X
  143.     ROL  FRACT+2,X
  144.     ROL  FRACT+1,X
  145.     ROLA
  146.   IFTST  (,S),EQ,#0         IF SNORM/LNORM CALL
  147.     TSTA             BRANCH IF NOT
  148.     BPL  SNLOOP          YET NORMALIZED
  149. *
  150.   ELSE                 ENORM CALL
  151.     IF    Y,GT,(3,S)         BRANCH IF NOT YET
  152.       BRA  SNLOOP         ORIGINAL EXPONENT
  153. *
  154.     ENDIF
  155. *
  156.   ENDIF
  157.   STA  FRACT,X             RESTORE FRCT AND EXPONENT
  158.   STY  EXP,X
  159.   ANDCC  #$F9             CLEAR Z AND V BIT
  160. SNOUT  EQU  *
  161.   LEAS    1,S             CLEAN UP STACK
  162.   PULS    D,Y,PC             RESTORE AND RETURN
  163.   PAGE
  164. ********************************************************
  165. *
  166. *    ENORM - NORMALIZE AN EXTENDED PRECISION NUMBER
  167. *    THAT IS IN INTERNAL FORM TO ITS ORIGINAL
  168. *    PRECISION
  169. *
  170. *    ON ENTRY: X POINTS TO ARGUMENT ON THE STACK FRAME
  171. *           Y CONTAINS ORIGINAL EXPONENT OF THE ARG.
  172. *
  173. *    ON EXIT:  THE NUMBER POINTED TO BY X IS NORMALIZED
  174. *    TO IT'S ORIGINAL PRECISION.
  175. *           Z IS SET IF THE FRACTION WAS ZERO. ADDITIONALLY
  176. *    THE NUMBER IS SET TO A TRUE ZERO
  177. *           V IS SET IF THE NUMBER BECAME DENORMALIZED
  178. *    DURING NORMALIZATION.
  179. *
  180. *    NOTE: MOST NUMBERS LEAVE THIS ROUTINE UNNORMALIZED.
  181. *    SINCE THE INNER PORTION OF THE LOOP OF THIS ALGORITHM
  182. *    WAS ALMOST IDENTICAL TO SNORM/LNORM THEY WERE COMBINED.
  183. *    A FLAG IS PUSHED ONTO THE STACK BEFORE THE CALL TO
  184. *    THE MUTUAL CODE TO DIFFERENTIATE THE UNSIMILAR CODE.
  185. *
  186. ***********************************************************
  187. *
  188. ENORM  PSHS  D,Y    SAVE CALLERS'S REGS
  189.   LDB  #1             SET FLAG FOR
  190.   STB  ,-S             ENORM CALL
  191.   BRA  MUTNRM             GO JOIN MUTUAL NORM. CODE
  192. *
  193.  PAGE
  194. *
  195. ************************************************************
  196. *
  197. * P R E C
  198. *
  199. *    THIS ROUTINE DETERMINES THE PRECISION OF AN ARGUMENT IN
  200. *    USER MEMORY.  THE VALUE RETURNED IS AN INDEX
  201. *    DEFINED AS:
  202. *      SINGLE     = 0
  203. *      DOUBLE     = 2
  204. *      EXTENDED  = 4
  205. *      EXTENDED ROUNDED TO SINGLE = 6
  206. *      EXTENDED ROUNDED TO DOUBLE = 8
  207. *
  208. *    PREC KNOWS ABOUT MOV AND CMP AND WILL RETURN THE
  209. *    PROPER PRECISION INDEX.
  210. *
  211. *    ENTRY:
  212. *      U = POINTER TO STACK FRAME
  213. *      FOR CMP B = 0 FOR ARG1; B.NE.0 FOR ARG2
  214. *      FOR MOV B = 0 FOR ARG2; B.NE.0 FOR RESULT
  215. *      FOR ALL OTHERS B IS A DON'T CARE
  216. *
  217. *    EXIT;
  218. *      B = PRECISION INDEX
  219. *      Z = 1 IFF B = 0
  220. *      ALL REGISTERS RESTORED EXCEPT CC BITS
  221. *
  222. *   **** MAJOR REVISIONS *****
  223. *    REVISOR      DATE        REASON
  224. *    JOEL BONEY  022980    ORIGINAL
  225. *    JOEL BONEY  031980    FASTER
  226. *
  227. *
  228. ***********************************************************
  229. *
  230. PREC  EQU  *
  231.   IFTST (FUNCT,U),GE,#0      IF NOT MIXED ARGUMENTS
  232.     LDB  [PFPCB,U]         GET FPCB CONTROL WORD. BITS 5-7 ARE PRECISION
  233.     LSRB             POSITION PRECISION IN 4LSB
  234.     LSRB
  235.     LSRB
  236.     LSRB
  237.     ANDB  #$0E             PRECISION NOW 0,2,4,6 OR 8
  238.     RTS              ADIOS
  239.   ELSE                 COMPARE OR MOVE
  240.     PSHS  A
  241.     LDA   TPARAM+1,U         GET PRECISION BYTE FROM STACK
  242.     IFTST B,EQ,#0         IF UPPER NYBBLE THEN
  243.       ANDA  #$70         POSITION IT
  244.       LSRA
  245.       LSRA
  246.       LSRA
  247.     ELSE             LOWER NYBBLE
  248.       ANDA  #$7          POSITION IT
  249.       LSLA
  250.     ENDIF
  251.     TFR A,B             PUT RESULT IN B
  252.     PULS A,PC             EXIT
  253.   ENDIF
  254. *
  255. *
  256.  PAGE
  257. ************************************************************
  258. *
  259. * S I Z E
  260. *
  261. *    THIS ROUTINE DETERMINES THE SIZE OF AN ARGUMENT IN
  262. *    USER MEMORY.  THE VALUE RETURNED IS:
  263. *      SINGLE     = 4
  264. *      DOUBLE     = 8
  265. *      EXTENDED  = 10
  266. *
  267. *    SIZE KNOWS ABOUT MOV AND CMP AND WILL RETURN THE
  268. *    PROPER SIZE.
  269. *
  270. *    ENTRY:
  271. *      U = POINTER TO STACK FRAME
  272. *      FOR CMP B = 0 FOR ARG1; B.NE.0 FOR ARG2
  273. *      FOR MOV B = 0 FOR ARG2; B.NE.0 FOR RESULT
  274. *      FOR ALL OTHERS B IS A DON'T CARE
  275. *
  276. *    EXIT;
  277. *      B = SIZE
  278. *      ALL REGISTERS RESTORED EXCEPT CC BITS
  279. *
  280. *
  281. *  ***** MAJOR REVISIONS *****
  282. *   REVISOR    DATE      REASON
  283. *   JOEL BONEY    022980      ORIGINAL
  284. *
  285. ***********************************************************
  286. *
  287. SIZE  EQU  *
  288.   PSHS    X
  289.   LEAX    SIZTAB,PCR         POINT TO SIZE TABLE
  290.   BSR  PREC             GO GET PRECISION
  291.   LSRB                 DIVIDE INDEX BY 2
  292.   LDB  B,X             CONVERT TO SIZE
  293.   PULS X,PC
  294. *
  295. * TABLE TO CONVERT PRECISION INDEX TO SIZE
  296. *
  297. SIZTAB EQU *
  298.   FCB 4,8,10,10,10
  299. *
  300. *
  301.